home *** CD-ROM | disk | FTP | other *** search
- ⓪ IMPLEMENTATION MODULE Storage;⓪ (*$Y+,R-*)⓪ ⓪ (*-----------------------------------------------------------------------------⓪!* Copyright Januar 1989 Thomas Tempelmann⓪!*-----------------------------------------------------------------------------⓪!* Kurzbeschreibung : Auf StorBase aufgesetzte, systemunabhängige Memory-⓪!* verwaltung für MOS⓪!*-----------------------------------------------------------------------------⓪!* Systemversion : MOS 1.1⓪!* Textversion : V#0293⓪!*-----------------------------------------------------------------------------⓪!* Datum Vers Autor Bemerkung (Arbeitsbericht)⓪!*-----------------------------------------------------------------------------⓪!* 14.02.92 2.15 TT 'valid' benutzt Super() statt Supexec() wg. MiNT.⓪!* 10.11.90 2.14 TT ALLOCATE/SysAlloc erkennt 0-size sofort⓪!* 08.11.90 TT $R-⓪!* 26.10.90 2.13 TT Neg. Überläufe bei size-Parm bei ALLOCATE/Enlarge weg.⓪!* 11.10.90 2.12 TT StorBase.Resize-Aufruf gab zu viel frei.⓪!* 09.10.90 2.11 TT DEALLOCATE gibt nix frei, wenn kein FullAcess und⓪!* size # 0; DEALLOCATE ruft ggf. Resize statt DEALLOCATE⓪!* in StorBase, damit shrink immer möglich ist.⓪!* 26.09.90 2.10 TT MaxBlSize wird bei ACCs auf 2KB gesetzt, weil sonst⓪!* gleich meist 32K drauf gehen.⓪!* 19.08.90 2.9 TT MemAvail macht keinen Overflow, wenn weniger als 40⓪!* Byte frei sind.⓪!* 29.07.90 2.8 TT Available geändert.⓪!* 23.07.90 2.7 TT ALLOCATE kann nun auch Speicher < MaxBlSize noch⓪!* anfordern, solange StorBase noch davon was übrig hat.⓪!* 15.07.90 2.6 TT Kritische StorBase-Routinen werden nur bei⓪!* 'FullStorBaseAccess' aufgerufen.⓪!* 13.06.90 TT EnterSupervisorMode raus⓪!* 14.03.90 2.5 TT ALOCATE/SysAlloc mit size=0 liefern NIL als Ptr.⓪!* (bisher wurde trotzdem ein Header alloziert);⓪!* MemAvail: BlockFullSize wird zusätzlich vom freien⓪!* Bereich abgezogen⓪!* 11.01.90 2.4 TT Verify-Routine in Asm kodiert, prüft nun auch⓪!* Pointer auf Gültigkeit, sodaß kein Adr/Bus-Error⓪!* kommen kann; außerdem wird bei Erkennen eines⓪!* Fehlers die Speicherkette mit den noch intakten⓪!* Daten geschlossen⓪!* 07.07.89 2.3 TT Optimierung einige Routinen in Asm⓪!* 05.06.89 2.3 TT Nach Freigabe residenter Module wird nun nicht mehr⓪!* Speicherverw. inkonsistent. Grund: 'valid' erkennt nun,⓪!* wenn schon freigegebener Bereich nochmal freigegeben⓪!* wird.⓪!* 02.06.89 2.3 TT More liefert ADR (Root) PROC (Resize) und PROC (Verify)⓪!* 14.05.89 2.2 TT Es steckt noch ein Fehler entw. in MemSize oder⓪!* DEALLOCATE mit size>0!⓪!* Zur Sicherheit bei blockOK.ubNeg ANDI.L eingefügt⓪!* (weiß aber nicht, ob dies redundant ist).⓪!* 04.03.89 2.1 TT getFree: full nicht erkannt, wenn origLen knapp unter⓪!* MaxBlSize lag. newBlock legte aber dann ggf. zuwenig⓪!* Speicher an.⓪!* 18.02.89 2.0 TT 1. Freigabe zum Testen (an Manuel, MAUS)⓪!*----------------------------------------------------------------------------*)⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER, WORD, LONGWORD, ADR, TSIZE, BYTE, ADDRESS;⓪ ⓪ FROM MOSGlobals IMPORT MemArea, InternalFault;⓪ ⓪ FROM MOSConfig IMPORT MaxBlSize;⓪ ⓪ FROM MOSSupport IMPORT ToSuper, ToUser;⓪ ⓪ FROM PrgCtrl IMPORT Accessory, EnvlpCarrier, TermCarrier, CatchProcessTerm,⓪(SetEnvelope;⓪ ⓪ IMPORT StorBase;⓪ ⓪ ⓪ TYPE⓪(PtrHead = POINTER TO Head;⓪ ⓪(HeadLink = RECORD⓪5n: INTEGER; (* rel. offset von block.data *)⓪5p: INTEGER; (* rel. offset von block.data *)⓪3END;⓪ ⓪(Head = RECORD; (* werden nur für used-Bereiche benutzt *)⓪2hd: HeadLink;⓪2root: INTEGER; (* rel. Offset von Block.data (pos.Wert) *)⓪2level: INTEGER;⓪2size: INTEGER; (* used-Größe, kann ungerade sein! *)⓪B(* -- muß immer vor 'hd.data' stehen *)⓪B(* damit 'fullBlk' funktioniert! *)⓪2data: BYTE (* Beginn der Daten *)⓪0END;⓪ CONST⓪(HeadSize = 10; (* TSIZE (Head ohne data) *)⓪ ⓪ TYPE⓪(PtrLink = POINTER TO Link;⓪ ⓪(Link = RECORD⓪1next: PtrLink;⓪1prev: PtrLink;⓪/END;⓪ ⓪(PtrBlock = POINTER TO Block;⓪ ⓪(Block = RECORD⓪2blk: Link;⓪2size: LONGINT; (* Größe des verfügbaren Bereichs *)⓪B(* kann ungerade sein! *)⓪B(* Bit 30: <full> *)⓪2CASE : CARDINAL OF⓪2| 0: (* full *)⓪4level: INTEGER;⓪4full: CARDINAL; (* = 0, wenn full *)⓪4fullData: BYTE⓪2| 1: (* root *)⓪4blRov: PtrBlock (* zeigt direkt auf letzten Block *)⓪2| 2: (* not full *)⓪4hd: HeadLink;⓪4hdRov: INTEGER; (* letzer hd, wo alloc durchgef. wurde *)⓪4free: LONGINT; (* gesamter freier Bereich in Block *)⓪4hds : BYTE (* Beginn der Header/Freibereiche *)⓪2END⓪0END;⓪ CONST⓪(BlockSize = 22; (* TSIZE (Block ohne hds) *)⓪(BlockFullSize = 16; (* TSIZE (Block, 0) *)⓪ ⓪ ⓪ VAR Root: Block;⓪$StorLevel: INTEGER; (* 0: Sys *)⓪$_membot, _memtop: ADDRESS;⓪ ⓪ ⓪ ⓪ PROCEDURE abs (bl: PtrBlock; hd: INTEGER): ADDRESS;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; RETURN ADR (bl^.hds) + LONGCARD (LONG (hd))⓪(MOVE -(A3),D0⓪(MOVE.L -(A3),A0⓪(; ADDA.W D0,A0⓪(; ADDA.W #BlockSize,A0⓪(LEA BlockSize(A0,D0.W),A0⓪(MOVE.L A0,(A3)+⓪$END⓪"END abs;⓪"(*$L=*)⓪ ⓪ PROCEDURE rel (bl: PtrBlock; ad: ADDRESS): INTEGER;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; RETURN SHORT ( ad - ADR (bl^.hds) )⓪(MOVE.L -(A3),D0⓪(MOVE.L -(A3),A0⓪(ADDA.W #BlockSize,A0⓪(SUB.L A0,D0⓪(MOVE.W D0,(A3)+⓪$END⓪"END rel;⓪"(*$L=*)⓪ ⓪ ⓪ MODULE BlkLists;⓪ ⓪"IMPORT ASSEMBLER, abs, rel, ADR, Link, PtrBlock, HeadLink, BlockSize;⓪ ⓪"EXPORT linkBlkIn, linkBlkOut,⓪)linkHdIn, linkHdOut;⓪ ⓪ (*⓪"PROCEDURE linkBlkIn (VAR l, at: Link);⓪$BEGIN⓪(l.prev:= at.prev;⓪(l.next:= ADR (at);⓪(at.prev^.next:= ADR (l);⓪(at.prev:= ADR (l)⓪$END linkBlkIn;⓪ ⓪"PROCEDURE linkBlkOut (VAR l: Link);⓪$BEGIN⓪(l.prev^.next:= l.next;⓪(l.next^.prev:= l.prev⓪$END linkBlkOut;⓪ ⓪"PROCEDURE linkHdIn (bl: PtrBlock; VAR l: HeadLink; before: INTEGER);⓪$VAR at, at2: POINTER TO HeadLink;⓪$BEGIN⓪(at:= abs (bl, before);⓪(l.p:= at^.p;⓪(l.n:= before;⓪(at2:= abs (bl, at^.p);⓪(at2^.n:= rel (bl, ADR (l));⓪(at^.p:= rel (bl, ADR (l))⓪$END linkHdIn;⓪ ⓪"PROCEDURE linkHdOut (bl: PtrBlock; VAR l: HeadLink);⓪$VAR at: POINTER TO HeadLink;⓪$BEGIN⓪(at:= abs (bl, l.p);⓪(at^.n:= l.n;⓪(at:= abs (bl, l.n);⓪(at^.p:= l.p⓪$END linkHdOut;⓪ *)⓪ ⓪"(*$L-*)⓪ ⓪"PROCEDURE linkBlkIn (VAR l, at: Link);⓪$BEGIN⓪&ASSEMBLER⓪(; l.prev:= at.prev;⓪(; l.next:= ADR (at);⓪(; at.prev^.next:= ADR (l);⓪(; at.prev:= ADR (l)⓪(MOVE.L -(A3),A1 ; ADR (at)⓪(MOVE.L -(A3),A0 ; ADR (l)⓪(MOVE.L Link.prev(A1),A2⓪(MOVE.L A2,Link.prev(A0)⓪(MOVE.L A1,Link.next(A0)⓪(MOVE.L A0,Link.next(A2)⓪(MOVE.L A0,Link.prev(A1)⓪&END⓪$END linkBlkIn;⓪ ⓪"PROCEDURE linkBlkOut (VAR l: Link);⓪$BEGIN⓪&ASSEMBLER⓪(; l.prev^.next:= l.next;⓪(; l.next^.prev:= l.prev⓪(MOVE.L -(A3),A0 ; ADR (l)⓪(MOVE.L Link.prev(A0),A1⓪(MOVE.L Link.next(A0),A2⓪(MOVE.L A2,Link.next(A1)⓪(MOVE.L A1,Link.prev(A2)⓪&END⓪$END linkBlkOut;⓪ ⓪"PROCEDURE linkHdIn (bl: PtrBlock; VAR l: HeadLink; before: INTEGER);⓪$VAR at, at2: POINTER TO HeadLink;⓪$BEGIN⓪&ASSEMBLER⓪(MOVE -(A3),D0 ; before⓪(MOVE.L -(A3),A0 ; ADR (l)⓪(MOVE.L -(A3),A1 ; bl⓪(; at:= abs (bl, before);⓪(; MOVE.L A1,A2⓪(; ADDA.W D0,A2⓪(; ADDA.W #BlockSize,A2 ; at⓪(LEA BlockSize(A1,D0.W),A2⓪(; l.p:= at^.p;⓪(MOVE.W HeadLink.p(A2),D1 ; at^.p⓪(MOVE.W D1,HeadLink.p(A0)⓪(; l.n:= before;⓪(MOVE.W D0,HeadLink.n(A0)⓪(; BERECHNE rel (bl, ADR (l)) NACH A0⓪(ADDA.W #BlockSize,A1⓪(SUBA.L A1,A0⓪(; at2:= abs (bl, at^.p);⓪(ADDA.W D1,A1 ; at2⓪(; at2^.n:= rel (bl, ADR (l));⓪(; at^.p:= rel (bl, ADR (l))⓪(MOVE.W A0,HeadLink.n(A1)⓪(MOVE.W A0,HeadLink.p(A2)⓪&END⓪$END linkHdIn;⓪ ⓪"PROCEDURE linkHdOut (bl: PtrBlock; VAR l: HeadLink);⓪$VAR at: POINTER TO HeadLink;⓪$BEGIN⓪&ASSEMBLER⓪(MOVE.L -(A3),A0 ; ADR (l)⓪(MOVE.L -(A3),A1 ; bl⓪(; at:= abs (bl, l.p);⓪(MOVE.L A1,A2⓪(ADDA.W HeadLink.p(A0),A2⓪(ADDA.W #BlockSize,A2 ; at⓪(; at^.n:= l.n;⓪(MOVE.W HeadLink.n(A0),HeadLink.n(A2)⓪(; at:= abs (bl, l.n);⓪(ADDA.W HeadLink.n(A0),A1⓪(ADDA.W #BlockSize,A1 ; at⓪(; at^.p:= l.p⓪(MOVE.W HeadLink.p(A0),HeadLink.p(A1)⓪&END⓪$END linkHdOut;⓪ ⓪"(*$L=*)⓪ ⓪"END BlkLists;⓪ ⓪ ⓪ PROCEDURE setBit6 (VAR i: ARRAY OF BYTE);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #2,A3⓪(MOVEA.L -(A3),A0⓪(BSET.B #6,(A0)⓪$END⓪"END setBit6;⓪"(*$L=*)⓪ ⓪ PROCEDURE blkFull (bl: PtrBlock): BOOLEAN;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A0⓪(BTST #6,Block.size(A0)⓪(SNE D0⓪(ANDI #1,D0⓪(MOVE D0,(A3)+⓪$END⓪"END blkFull;⓪"(*$L=*)⓪ ⓪ PROCEDURE blkSize (bl: PtrBlock): LONGINT;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A0⓪(MOVE.L Block.size(A0),D0⓪(ANDI.L #$00FFFFFF,D0⓪(MOVE.L D0,(A3)+⓪$END⓪"END blkSize;⓪"(*$L=*)⓪ ⓪ PROCEDURE sizeHd (bl: PtrBlock; hd: INTEGER): INTEGER;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; hdp:= abs (bl, hd);⓪(; RETURN val (hdp^.size)⓪(MOVE -(A3),D0⓪(MOVE.L -(A3),A0⓪(MOVE.W Head.size+BlockSize(A0,D0.W),D0⓪(ADDQ #1,D0⓪(ANDI #$FFFE,D0⓪(MOVE D0,(A3)+⓪$END;⓪"END sizeHd;⓪"(*$L=*)⓪ ⓪ PROCEDURE nextHd (bl: PtrBlock; hd: INTEGER): INTEGER;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; hdp:= abs (bl, hd);⓪(; RETURN hdp^.hd.n⓪(MOVE -(A3),D0⓪(MOVE.L -(A3),A0⓪(MOVE.W Head.hd.n+BlockSize(A0,D0.W),(A3)+⓪$END;⓪"END nextHd;⓪"(*$L=*)⓪ ⓪ PROCEDURE prevHd (bl: PtrBlock; hd: INTEGER): INTEGER;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; hdp:= abs (bl, hd);⓪(; RETURN hdp^.hd.p⓪(MOVE -(A3),D0⓪(MOVE.L -(A3),A0⓪(MOVE.W Head.hd.p+BlockSize(A0,D0.W),(A3)+⓪$END;⓪"END prevHd;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE valid (ad: ADDRESS; VAR bl: PtrBlock;⓪2VAR hd: PtrHead; VAR full: BOOLEAN): BOOLEAN;⓪"(* Verkettung prüfen und ggf. 'bl' und 'full' setzen *)⓪"(*$L-*)⓪"BEGIN⓪$(*⓪&IF ad = NIL THEN RETURN FALSE END;⓪&full:= fullBlk (ad);⓪&IF full THEN⓪(bl:= ad - LONG (BlockFullSize);⓪&ELSE⓪(hd:= ad - LONG (HeadSize);⓪(bl:= ADDRESS (hd) - LONGCARD (LONG (hd^.root + BlockSize));⓪(IF nextHd (bl, hd.p)) # prevHd (bl, hd.n)) # hd THEN⓪*RETURN FALSE⓪(END⓪&END;⓪&RETURN bl^.blk.next^.prev = bl^.blk.prev^.next⓪$*)⓪$ASSEMBLER⓪(SUBQ.L #4,A7⓪(JSR ToSuper⓪ ⓪(MOVE.L 8,-(A7) ; bus error vector⓪(MOVE.L 12,-(A7) ; address error vector⓪(LEA inval(PC),A0⓪(MOVE.L A0,8⓪(MOVE.L A0,12⓪(MOVE.L A7,D1⓪(⓪(MOVE.L -(A3),A2 ; full⓪(MOVE.L -(A3),D2 ; hd⓪(MOVE.L -(A3),A1 ; bl⓪(MOVE.L -(A3),A0 ; ad⓪(⓪(MOVE.L A0,D0⓪(BEQ inval⓪(⓪(TST.W -2(A0) ; bei <full> ist 'hd.size' = 0⓪(SEQ D0⓪(ANDI #1,D0⓪(MOVE D0,(A2) ; full setzen⓪(⓪(BEQ notfull⓪(⓪(; bl:= ad - LONG (BlockFullSize)⓪(MOVE.L A0,A2⓪(SUBA.W #BlockFullSize,A2⓪(MOVE.L A2,(A1)⓪(BRA fullend⓪(⓪¬full⓪(; hd:= ad - LONG (HeadSize);⓪(MOVE.L A0,A2⓪(SUBA.W #HeadSize,A2⓪(MOVE.L D2,A0⓪(MOVE.L A2,(A0)⓪(; bl:= ADDRESS (hd) - LONGCARD (LONG (hd^.root + BlockSize));⓪(MOVE.L A2,A0 ; hd retten⓪(SUBA.W Head.root(A2),A2⓪(SUBA.W #BlockSize,A2⓪(MOVE.L A2,(A1)⓪(⓪(; rel (bl, hd):⓪(MOVE.L A0,D2 ; hd⓪(MOVE.L A2,A1 ; bl⓪(ADDA.W #BlockSize,A1⓪(SUB.L A1,D2⓪(; IF nextHd (bl, hd.p)) # prevHd (bl, hd.n)) # rel (bl, hd) THEN⓪(MOVE.W Head.hd.p(A0),D0⓪(CMP.W Head.hd.n+BlockSize(A2,D0.W),D2⓪(BNE inval⓪(MOVE.W Head.hd.n(A0),D0⓪(CMP.W Head.hd.p+BlockSize(A2,D0.W),D2⓪(BNE inval⓪(⓪&fullend⓪(; RETURN bl^.blk.next^.prev = bl^.blk.prev^.next⓪(MOVE.L Block.blk.next(A2),A1⓪(MOVE.L Block.blk.prev(A1),D0⓪(MOVE.L Block.blk.prev(A2),A1⓪(CMP.L Block.blk.next(A1),D0⓪(SEQ D0⓪(ANDI #1,D0⓪(MOVE D0,(A3)+⓪(BRA ende⓪&inval:⓪(CLR (A3)+⓪(MOVE.L D1,A7⓪&ende:⓪(MOVE.L (A7)+,12⓪(MOVE.L (A7)+,8⓪(⓪(JSR ToUser⓪(ADDQ.L #4,A7⓪$END⓪"END valid;⓪"(*$L=*)⓪ ⓪ PROCEDURE incHdSize (hd: PtrHead; siz: CARDINAL);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W -(A3),D0⓪(MOVE.L -(A3),A0⓪(ADD.W D0,Head.size(A0)⓪$END⓪"END incHdSize;⓪"(*$L=*)⓪ ⓪ PROCEDURE decHdSize (hd: PtrHead; siz: CARDINAL);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.W -(A3),D0⓪(MOVE.L -(A3),A0⓪(SUB.W D0,Head.size(A0)⓪$END⓪"END decHdSize;⓪"(*$L=*)⓪ ⓪ PROCEDURE resize (VAR ad: ADDRESS; len: LONGINT): BOOLEAN;⓪"(*⓪#* 'len': wenn pos, dann Abzugswert; wenn neg., dann Vergrößerungsoffset;⓪#* wenn Null, dann ganz freigeben.⓪#* 'ad' bleibt unverändert, wenn RETURN FALSE⓪#*)⓪ ⓪"VAR hd: PtrHead; bl: PtrBlock; ok, full: BOOLEAN;⓪&i: CARDINAL;⓪ ⓪"PROCEDURE blkAway;⓪$BEGIN⓪&IF Root.blRov = bl THEN Root.blRov:= NIL END;⓪&linkBlkOut (bl^.blk);⓪&StorBase.DEALLOCATE (bl, 0)⓪$END blkAway;⓪ ⓪"VAR this, freeEnd, freeBeg: INTEGER;⓪&dumusedbeg, duml, dumfreebeg: INTEGER;⓪ ⓪"BEGIN (* resize *)⓪$IF NOT valid (ad,bl,hd,full) THEN⓪&RETURN FALSE⓪$END;⓪$IF full THEN⓪&(* <full> block: ad zeigt hinter Block(0) *)⓪&IF len < 0L THEN⓪((* Block um 'len' vergrößern *)⓪(IF StorBase.FullStorBaseAccess () THEN⓪*StorBase.Enlarge (bl, -len, ok);⓪*IF ok THEN bl^.size:= bl^.size + ABS (len) END;⓪*RETURN ok⓪(ELSE⓪*RETURN FALSE⓪(END⓪&ELSIF (len > 0L) AND (len < blkSize (bl)) THEN⓪((* shrink only *)⓪(bl^.size:= bl^.size - len;⓪((* Blockgröße neu setzen. Plus den Block-Header und aufrunden: *)⓪(StorBase.Resize (bl, (BlockFullSize + blkSize (bl) + 1) DIV 2 * 2, ok);⓪(RETURN ok⓪&ELSE⓪(blkAway;⓪(ad:= NIL⓪&END⓪$ELSE (* NOT full: *)⓪&(* ad zeigt hinter Header *)⓪&IF len < 0L THEN⓪((* Block um 'len' vergrößern *)⓪(this:= rel (bl, hd);⓪(freeEnd:= nextHd (bl, this);⓪(IF freeEnd < 0 THEN freeEnd:= SHORT (blkSize (bl)) END;⓪(freeBeg:= this + HeadSize + sizeHd (bl, this);⓪(IF ABS (len) <= LONG (freeEnd - freeBeg) THEN⓪*i:= SHORT (ABS (len));⓪*incHdSize (hd, i);⓪*DEC (bl^.free, (ORD (ODD (hd^.size)) + i) DIV 2 * 2)⓪(ELSE⓪*RETURN FALSE⓪(END⓪&ELSIF (len > 0L) AND (len < LONG (hd^.size)) THEN⓪((* shrink only *)⓪(i:= SHORT (len);⓪(decHdSize (hd, i);⓪(INC (bl^.free, (ORD (NOT ODD (hd^.size)) + i) DIV 2 * 2)⓪&ELSE⓪(i:= hd^.size + HeadSize;⓪(IF ODD (i) THEN INC (i) END;⓪(INC (bl^.free, i);⓪(IF bl^.hdRov = rel (bl, hd) THEN⓪*bl^.hdRov:= prevHd (bl, bl^.hdRov)⓪(END;⓪(linkHdOut (bl, hd^.hd);⓪(IF bl^.free = blkSize (bl) THEN blkAway END;⓪((*⓪*IF hd^.size = 966 THEN⓪,WriteLn;⓪,WriteString ('bl^.size: '); WriteString (CardToStr (bl^.size,0)); WriteLn;⓪,WriteString ('bl^.free: '); WriteString (CardToStr (bl^.free,0)); WriteLn;⓪,dumfreebeg:= 0; (* End of last used area *)⓪,dumusedbeg:= bl^.hd.n; (* Start of new used area *)⓪,LOOP⓪.IF dumusedbeg < 0 THEN⓪0duml:= VAL (INTEGER, blkSize (bl)) - dumfreebeg;⓪0IF duml > 0 THEN WriteString ('free: '); WriteString (IntToStr (duml,8)); WriteString (IntToStr (nextHd(bl,dumusedbeg),8)); WriteString (IntToStr (prevHd(bl,dumusedbeg),8)); WriteLn; END;⓪0EXIT⓪.ELSE⓪0duml:= dumusedbeg - dumfreebeg;⓪0IF duml > 0 THEN WriteString ('free: '); WriteString (IntToStr (duml,8)); WriteString (IntToStr (nextHd(bl,dumusedbeg),8)); WriteString (IntToStr (prevHd(bl,dumusedbeg),8)); WriteLn END;⓪.END;⓪.WriteString ('used: ');⓪.WriteString (IntToStr (sizeHd (bl, dumusedbeg),8));⓪.WriteString (IntToStr (nextHd(bl,dumusedbeg),8));⓪.WriteString (IntToStr (prevHd(bl,dumusedbeg),8));⓪.WriteLn;⓪.dumfreebeg:= dumusedbeg + HeadSize + sizeHd (bl, dumusedbeg);⓪.dumusedbeg:= nextHd (bl, dumusedbeg)⓪,END;⓪*END;⓪(*)⓪(ad:= NIL⓪&END;⓪$END;⓪$RETURN TRUE⓪"END resize;⓪ ⓪ PROCEDURE blockOK (VAR freeBeg, usedBeg: INTEGER;⓪3neededLen: LONGINT; bl: PtrBlock): BOOLEAN;⓪"(*$L-*)⓪"(* freien Bereich im Block 'bl' suchen *)⓪"VAR end: INTEGER;⓪&hd: PtrHead;⓪"BEGIN⓪$ASSEMBLER⓪((*⓪*end:= bl^.hdRov;⓪*usedBeg:= nextHd (bl, end); (* Start of new used area *)⓪*IF end < 0 THEN⓪,freeBeg:= 0; (* End of last used area *)⓪*ELSE⓪,freeBeg:= end + HeadSize + sizeHd (bl, end);⓪*END;⓪*LOOP⓪,IF usedBeg < 0 THEN⓪.IF (SHORT (blkSize (bl)) - freeBeg) >= SHORT (neededLen) THEN EXIT END;⓪,ELSE⓪.IF (usedBeg - freeBeg) >= SHORT (neededLen) THEN EXIT END⓪,END;⓪,IF usedBeg = end THEN RETURN FALSE END;⓪,IF usedBeg < 0 THEN⓪.freeBeg:= 0⓪,ELSE⓪.freeBeg:= usedBeg + HeadSize + sizeHd (bl, usedBeg)⓪,END;⓪,usedBeg:= nextHd (bl, usedBeg)⓪*END;⓪*RETURN TRUE⓪(*)⓪(MOVEM.L D3-D6/A4/A5,-(A7)⓪ ⓪(MOVE.L -(A3),A5 ; A5: bl⓪ ⓪(; end:= bl^.hdRov⓪(MOVE.W Block.hdRov(A5),D3 ; D3: end⓪ ⓪(; usedBeg:= nextHd (bl, end)⓪(MOVE.W Head.hd.n+BlockSize(A5,D3.W),D4 ; D4: usedBeg⓪ ⓪(; IF end < 0 THEN freeBeg:= 0 ELSE⓪(; freeBeg:= end + HeadSize + sizeHd (bl, end) END;⓪(CLR.W D5 ; D5: freeBeg⓪(TST.W D3⓪(BMI endNeg⓪(MOVE D3,D5⓪(ADDI.W #HeadSize+1,D5⓪(ADD.W Head.size+BlockSize(A5,D3.W),D5⓪(ANDI #$FFFE,D5⓪&endNeg:⓪ ⓪(MOVE.L -(A3),D6 ; D6: neededLen⓪ ⓪(MOVEQ #HeadSize+1,D1⓪(MOVE #$FFFE,D2⓪ ⓪&loop1:⓪(TST D4⓪(BMI ubNeg⓪ ⓪&ubPos:⓪(MOVE D4,D0⓪(SUB.W D5,D0⓪(CMP.W D6,D0⓪(BCC retTRUE⓪(CMP D3,D4⓪(BEQ retFALSE⓪(MOVE D4,D5⓪(ADD.W D1,D5⓪(ADD.W Head.size+BlockSize(A5,D4.W),D5⓪(AND D2,D5⓪(MOVE.W Head.hd.n+BlockSize(A5,D4.W),D4⓪(BPL ubPos⓪ ⓪&ubNeg:⓪(MOVE.L Block.size(A5),D0⓪(ANDI.L #$00FFFFFF,D0⓪(SUB.W D5,D0⓪(CMP.W D6,D0⓪(BCC retTRUE⓪(CMP D3,D4⓪(BEQ retFALSE⓪(CLR D5⓪(MOVE.W Head.hd.n+BlockSize(A5,D4.W),D4⓪(BRA loop1⓪ ⓪&retFALSE:⓪(CLR D0⓪(BRA return⓪ ⓪&retTRUE:⓪(MOVEQ #1,D0⓪ ⓪&return:⓪(MOVE.L -(A3),A0 ; ADR (usedBeg)⓪(MOVE D4,(A0)⓪(MOVE.L -(A3),A0 ; ADR (freeBeg)⓪(MOVE D5,(A0)⓪(MOVEM.L (A7)+,D3-D6/A4/A5⓪(MOVE D0,(A3)+⓪$END⓪"END blockOK;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE getFree (origLen: LONGINT; VAR neededLen: LONGINT; VAR full: BOOLEAN;⓪3VAR blSize: LONGINT; VAR bl: PtrBlock;⓪3VAR usedBeg, freeBeg: INTEGER): BOOLEAN;⓪ ⓪"VAR bl0: PtrBlock;⓪ ⓪"BEGIN (* getFree *)⓪$neededLen:= origLen;⓪$IF ODD (neededLen) THEN INC (neededLen) END;⓪$full:= (neededLen + LONG(HeadSize)) >= MaxBlSize;⓪$IF NOT full THEN⓪&INC (neededLen, HeadSize); (* der Head muß nun auf jeden Fall rein *)⓪&bl0:= Root.blRov;⓪&IF bl0 = NIL THEN bl0:= ADDRESS (Root.blk.next) END;⓪&bl:= bl0;⓪&REPEAT (* alle Blocks nach freiem Platz durchsuchen *)⓪(IF (bl # ADR (Root))⓪(AND NOT blkFull (bl)⓪(AND (bl^.free >= neededLen) THEN⓪*IF blockOK (freeBeg, usedBeg, neededLen, bl) THEN⓪,RETURN TRUE⓪*END⓪(END;⓪(bl:= ADDRESS (bl^.blk.next)⓪&UNTIL bl = bl0;⓪&blSize:= MaxBlSize + LONG (BlockSize)⓪$ELSE⓪&blSize:= neededLen + LONG (BlockFullSize)⓪$END;⓪$RETURN FALSE⓪"END getFree;⓪ ⓪ ⓪ PROCEDURE alloc (origLen: LONGINT; level: INTEGER): ADDRESS;⓪ ⓪"VAR freeBeg, usedBeg: INTEGER;⓪&bl: PtrBlock;⓪&blSize, neededLen: LONGINT;⓪&full: BOOLEAN;⓪ ⓪"PROCEDURE newBlock (): BOOLEAN;⓪$BEGIN⓪&StorBase.SysAlloc (bl, blSize);⓪&IF bl = NIL THEN RETURN FALSE END;⓪&IF full THEN⓪(linkBlkIn (bl^.blk, Root.blk);⓪(bl^.size:= origLen;⓪(bl^.level:= level;⓪(setBit6 (bl^.size); (* full-Kennung *)⓪(bl^.full:= 0; (* full-Kennung *)⓪&ELSE⓪(WITH bl^ DO⓪*linkBlkIn (blk, Root.blk);⓪*size:= MaxBlSize; (* 'size' enth. Größe des verfügbaren Bereichs *)⓪*free:= size;⓪*hd.n:= rel (bl, ADR (hd));⓪*hd.p:= hd.n;⓪*hdRov:= hd.n⓪(END⓪&END;⓪&Root.blRov := bl;⓪&RETURN TRUE⓪$END newBlock;⓪ ⓪"PROCEDURE insert (): ADDRESS;⓪$(* Bereich belegen *)⓪$VAR hd: PtrHead;⓪$BEGIN⓪&(* 'bl' zeigt auf Block, der freien Bereich enthält *)⓪&hd:= abs (bl, freeBeg);⓪&hd^.size:= SHORT (origLen);⓪&hd^.level:= level;⓪&linkHdIn (bl, hd^.hd, usedBeg);⓪&hd^.root:= freeBeg;⓪&DEC (bl^.free, CARDINAL (SHORT (neededLen))); (* origLen + HeadSize *)⓪&bl^.hdRov:= freeBeg;⓪&Root.blRov := bl;⓪&RETURN ADR (hd^.data)⓪$END insert;⓪ ⓪"VAR lastMax: LONGCARD;⓪ ⓪"BEGIN (* alloc *)⓪$IF origLen = 0L THEN⓪&RETURN NIL⓪$END;⓪$IF getFree (origLen, neededLen, full, blSize, bl, usedBeg, freeBeg) THEN⓪&RETURN insert ()⓪$END;⓪$IF NOT newBlock () THEN⓪&IF full THEN RETURN NIL END;⓪&(*⓪'* wenn weniger als MaxBlSize benötigt, aber nicht mehr Platz für⓪'* einen ganzen neuen Verwaltungsblock da ist, dann eben einen⓪'* full-Block mit der benötigten Size anfordern.⓪'*)⓪&lastMax:= MaxBlSize;⓪&MaxBlSize:= origLen; (* full-Block erzwingen *)⓪&IF getFree (origLen, neededLen, full, blSize, bl, usedBeg, freeBeg) THEN⓪((* muß FALSE liefern *)⓪&END;⓪&MaxBlSize:= lastMax;⓪&IF NOT newBlock () THEN RETURN NIL END⓪$END;⓪$IF full THEN RETURN ADR (bl^.fullData) END;⓪$IF NOT blockOK (freeBeg, usedBeg, neededLen, bl) THEN⓪&ASSEMBLER⓪(TRAP #6⓪(DC.W InternalFault-$C000 ; text follows, caller caused⓪(ACZ 'Storage allocation error'⓪(SYNC⓪&END⓪$END;⓪$RETURN insert ()⓪"END alloc;⓪ ⓪ PROCEDURE Verify (): CARDINAL;⓪"(*⓪#* Liefert 0, wenn alle Block- und Head-Verkettungen OK sind⓪#*⓪#* VORSICHT: Da auch full-Blocks angelegt werden können, die⓪#* kleiner als MaxBlSize sind, keinesfalls full-Blocks⓪#* dahingehend prüfen!⓪#*)⓪ ⓪"(* VAR bl: PtrBlock; hd: PtrHead; freeBeg, usedBeg: INTEGER; l: LONGINT; *)⓪"VAR result: CARDINAL;⓪ ⓪ (*$R-*)⓪"BEGIN⓪$ASSEMBLER⓪(LEA Root,A0⓪(BRA loop1⓪&err1⓪(BRA.W errEnd⓪&loop1⓪(MOVE.L Block.blk.next(A0),A0⓪(MOVE.L A0,D0⓪(BTST #0,D0 ; ungerade?⓪(BNE err1⓪((* das geht nicht im Fast-RAM des TT!!!⓪*CMPA.L _membot,A0 ; < membot?⓪*BCS err1⓪*CMPA.L _memtop,A0 ; > memtop?⓪*BCC err1⓪(*)⓪(CMPA.L #Root,A0⓪(BEQ.W exit1 ; ende ? -> OK⓪(BTST #6,Block.size(A0)⓪(BEQ notFull⓪(TST.L Block.size(A0)⓪(BMI err1⓪(MOVE.W Block.level(A0),D0⓪(CMP.W StorLevel,D0⓪(BHI err1⓪(TST.W Block.full(A0)⓪(BNE err1⓪(BRA loop1⓪¬Full⓪(; IF bl^.size > (MaxBlSize + LONG (BlockSize)) THEN RETURN 4 END;⓪(MOVE.L Block.size(A0),D1⓪ (* *** das darf nicht geprüft werden, weil MaxBlSize variieren kann! ***⓪(MOVE.L MaxBlSize,D0⓪(ADDI.L #BlockSize,D0⓪(CMP.L D0,D1⓪(BHI err1⓪ *)⓪(; IF bl^.free >= bl^.size THEN RETURN 18 END;⓪(MOVE.L Block.free(A0),D0⓪(CMP.L D1,D0⓪(BCC err1⓪(; IF ODD (bl^.size) THEN RETURN 5 END;⓪(BTST #0,D1⓪(BNE err1⓪(; hd:= abs (bl, bl^.hdRov);⓪(MOVE.W Block.hdRov(A0),D0⓪(BTST #0,D0⓪(BNE err1⓪(LEA BlockSize(A0,D0.W),A2⓪(; IF hd^.root # bl^.hdRov THEN RETURN 6 END;⓪(CMP.W Head.root(A2),D0⓪(BNE err1⓪(⓪(; usedBeg:= bl^.hd.n;⓪(MOVE.W Block.hd.n(A0),D1 ; usedBeg⓪(; l:= 0;⓪(CLR.W -(A7) ; l⓪(BRA loop2⓪&err2⓪(ADDQ.L #2,A7⓪(BRA err1⓪&loop2⓪(; IF ODD (usedBeg) THEN RETURN 7 END;⓪(BTST #0,D1⓪(BNE err2⓪(; IF usedBeg < 0 THEN⓪(TST.W D1⓪(BPL notNeg⓪(; IF usedBeg # rel (bl, ADR (bl^.hd)) THEN RETURN 8 END;⓪(CMPI.W #$FFF6,D1⓪(BNE err2⓪(; EXIT⓪(BRA exit2⓪(; END;⓪¬Neg⓪(; hd:= abs (bl, usedBeg);⓪(LEA BlockSize(A0,D1.W),A2⓪(; IF prevHd (bl, nextHd (bl, usedBeg)) # usedBeg THEN RETURN 20 END;⓪(; IF ODD (nextHd (bl, usedBeg)) THEN RETURN 14 END;⓪(MOVE.W Head.hd.n+BlockSize(A0,D1.W),D2⓪(BTST #0,D2⓪(BNE err2⓪(CMP.W Head.hd.p+BlockSize(A0,D2.W),D1⓪(BNE err2⓪(; IF nextHd (bl, prevHd (bl, usedBeg)) # usedBeg THEN RETURN 19 END;⓪(; IF ODD (prevHd (bl, usedBeg)) THEN RETURN 15 END;⓪(MOVE.W Head.hd.p+BlockSize(A0,D1.W),D2⓪(BTST #0,D2⓪(BNE err2⓪(CMP.W Head.hd.n+BlockSize(A0,D2.W),D1⓪(BNE err2⓪(; IF hd^.size < 0 THEN RETURN 9 END;⓪(MOVEQ #0,D2⓪(MOVE.W Head.size(A2),D2⓪(BLE err2 ; hd.size <= 0 ?⓪(; IF LONG (hd^.size) > bl^.size THEN RETURN 10 END;⓪(CMP.L Block.size(A0),D2⓪(BHI err2⓪(; IF hd^.level > StorLevel THEN RETURN 11 END;⓪(MOVE.W Head.level(A2),D0⓪(CMP.W StorLevel,D0⓪(BHI err2⓪(; IF hd^.root # usedBeg THEN RETURN 12 END;⓪(CMP.W Head.root(A2),D1⓪(BNE err2⓪(; INC (l, HeadSize+CARDINAL (hd^.size));⓪(; IF ODD (hd^.size) THEN INC (l) END;⓪(ADDI.W #HeadSize,D2⓪(ADDQ #1,D2⓪(BCLR #0,D2⓪(ADD.W D2,(A7)⓪(BCS err2⓪((* macht keinen Sinn, weil 'sizeHd' sowieso Sync macht:⓪*; freeBeg:= usedBeg + HeadSize + sizeHd (bl, usedBeg);⓪*; IF ODD (freeBeg) THEN RETURN 13 END;⓪(*)⓪(; usedBeg:= nextHd (bl, usedBeg)⓪(MOVE.W Head.hd.n+BlockSize(A0,D1.W),D1⓪(BRA loop2⓪&exit2⓪(; IF (bl^.size-l) # bl^.free THEN RETURN 17 END⓪(MOVE.L Block.size(A0),D0⓪(MOVEQ #0,D2⓪(MOVE.W (A7)+,D2⓪(SUB.L D2,D0⓪(CMP.L Block.free(A0),D0⓪(BEQ loop1⓪&errEnd⓪(LEA Root,A0⓪(MOVE.L A0,Block.blk.next(A0) ; Liste retten, indem Liste geleert wird⓪(MOVE.L A0,Block.blk.prev(A0)⓪(CLR.L Block.blRov(A0)⓪(MOVEQ #1,D0⓪(BRA ende⓪&exit1⓪(MOVEQ #0,D0⓪&ende⓪(MOVE D0,result(A6)⓪$END;⓪$RETURN result⓪ (*⓪$bl:= ADR (Root);⓪$LOOP⓪&bl:= ADDRESS (bl^.blk.next);⓪&IF bl = ADR (Root) THEN EXIT END;⓪&IF blkFull (bl) THEN⓪((* Block-Werte prüfen *)⓪(IF bl^.size < 0L THEN RETURN 1 END;⓪(IF bl^.level > StorLevel THEN RETURN 2 END;⓪(IF bl^.full # 0 THEN RETURN 3 END;⓪&ELSE⓪((* Block-Werte prüfen *)⓪((*** das darf nicht geprüft werden, weil MaxBlSize variieren kann! ***⓪*IF bl^.size > (MaxBlSize + LONG (BlockSize)) THEN RETURN 4 END;⓪(*)⓪(IF bl^.free >= bl^.size THEN RETURN 18 END;⓪(IF ODD (bl^.size) THEN RETURN 5 END;⓪(hd:= abs (bl, bl^.hdRov);⓪(IF hd^.root # bl^.hdRov THEN RETURN 6 END;⓪(usedBeg:= bl^.hd.n; (* Start of new used area *)⓪(l:= 0;⓪(LOOP⓪*IF ODD (usedBeg) THEN RETURN 7 END;⓪*IF usedBeg < 0 THEN⓪,IF usedBeg # rel (bl, ADR (bl^.hd)) THEN RETURN 8 END;⓪,EXIT⓪*END;⓪*hd:= abs (bl, usedBeg);⓪*(* Head prüfen *)⓪*IF nextHd (bl, prevHd (bl, usedBeg)) # usedBeg THEN RETURN 19 END;⓪*IF prevHd (bl, nextHd (bl, usedBeg)) # usedBeg THEN RETURN 20 END;⓪*IF hd^.size < 0 THEN RETURN 9 END;⓪*IF LONG (hd^.size) > bl^.size THEN RETURN 10 END;⓪*IF hd^.level > StorLevel THEN RETURN 11 END;⓪*IF hd^.root # usedBeg THEN RETURN 12 END;⓪*INC (l, HeadSize+CARDINAL (hd^.size));⓪*IF ODD (hd^.size) THEN INC (l) END;⓪*freeBeg:= usedBeg + HeadSize + sizeHd (bl, usedBeg);⓪*IF ODD (freeBeg) THEN RETURN 13 END;⓪*IF ODD (nextHd (bl, usedBeg)) THEN RETURN 14 END;⓪*IF ODD (prevHd (bl, usedBeg)) THEN RETURN 15 END;⓪*IF nextHd (bl, prevHd (bl, usedBeg))⓪+# prevHd (bl, nextHd (bl, usedBeg)) THEN RETURN 16 END;⓪*usedBeg:= nextHd (bl, usedBeg)⓪(END;⓪(IF (bl^.size-l) # bl^.free THEN RETURN 17 END⓪&END;⓪$END;⓪$RETURN 0⓪ *)⓪"END Verify;⓪ (*$R=*)⓪ ⓪ ⓪ PROCEDURE Inconsistent (): BOOLEAN;⓪"BEGIN⓪$RETURN StorBase.Inconsistent () OR (Verify () # 0)⓪"END Inconsistent;⓪ ⓪ ⓪ PROCEDURE ALLOCATE ( VAR addr: ADDRESS; size: LONGCARD );⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; addr:= alloc (size, StorLevel);⓪(CLR.L D0⓪(MOVE.L -(A3),D1 ; size⓪(BLE error⓪(MOVE.L D1,(A3)+⓪(MOVE StorLevel,(A3)+⓪(JSR alloc⓪(MOVE.L -(A3),D0⓪&error⓪(MOVE.L -(A3),A0 ; addr⓪(MOVE.L D0,(A0)⓪$END;⓪"END ALLOCATE;⓪"(*$L=*)⓪ ⓪ PROCEDURE SysAlloc ( VAR addr: ADDRESS; size: LONGCARD );⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; addr:= alloc (size, 0);⓪(CLR.L D0⓪(MOVE.L -(A3),D1 ; size⓪(BLE error⓪(MOVE.L D1,(A3)+⓪(CLR (A3)+⓪(JSR alloc⓪(MOVE.L -(A3),D0⓪&error⓪(MOVE.L -(A3),A0 ; addr⓪(MOVE.L D0,(A0)⓪$END;⓪"END SysAlloc;⓪"(*$L=*)⓪ ⓪ ⓪ PROCEDURE DEALLOCATE ( VAR addr: ADDRESS; size: LONGCARD );⓪"BEGIN⓪$IF LONGINT (size) < 0 THEN⓪&size:= MAX (LONGINT)⓪$END;⓪$IF NOT resize (addr, size) THEN⓪&(* versuchen wir's mit StorBase... *)⓪&IF (size # 0) & NOT StorBase.FullStorBaseAccess () THEN⓪((* nichts freigeben *)⓪(RETURN⓪&END;⓪&StorBase.DEALLOCATE (addr, size)⓪$END;⓪"END DEALLOCATE;⓪ ⓪ ⓪ PROCEDURE Available ( size: LONGCARD ): BOOLEAN;⓪ (*⓪"VAR freeBeg, usedBeg: INTEGER;⓪&bl: PtrBlock;⓪&blSize, neededLen: LONGINT;⓪&full: BOOLEAN;⓪ *)⓪"VAR ad: ADDRESS;⓪"BEGIN⓪$(* Alt:⓪(IF getFree (size, neededLen, full, blSize, bl, usedBeg, freeBeg) THEN⓪*RETURN TRUE⓪(ELSE⓪*RETURN StorBase.Available (blSize)⓪(END⓪$*)⓪$(* 29.7.90: *)⓪$ALLOCATE (ad, size);⓪$IF ad = NIL THEN RETURN FALSE END;⓪$DEALLOCATE (ad, 0);⓪$RETURN TRUE⓪"END Available;⓪ ⓪ ⓪ PROCEDURE MemSize ( addr: ADDRESS ): LONGCARD;⓪"VAR hd: PtrHead; bl: PtrBlock; full: BOOLEAN;⓪"BEGIN⓪$IF valid (addr,bl,hd,full) THEN⓪&IF full THEN⓪(RETURN blkSize (bl)⓪&ELSE⓪(RETURN LONG (hd^.size)⓪&END⓪$ELSE⓪&IF StorBase.FullStorBaseAccess () THEN⓪(RETURN StorBase.MemSize (addr)⓪&ELSE⓪(RETURN 0⓪&END⓪$END⓪"END MemSize;⓪ ⓪ ⓪ PROCEDURE MemAvail (): LONGCARD;⓪"VAR l: LONGINT;⓪"BEGIN⓪$(* Aus Programmierfaulheit suchen wir nicht extra in den Blocks⓪%* nach dem größten Block sondern fragen nur StorBase.⓪%*)⓪$l:= INT (StorBase.MemAvail ()) - LONG (BlockSize+BlockFullSize+2);⓪$IF l < 0 THEN l:= 0 END;⓪$RETURN l⓪"END MemAvail;⓪ ⓪ ⓪ PROCEDURE AllAvail (): LONGCARD;⓪"⓪"VAR bl: PtrBlock; av: LONGINT;⓪ ⓪"BEGIN⓪$av:= StorBase.AllAvail ();⓪$bl:= ADR (Root);⓪$LOOP⓪&bl:= ADDRESS (bl^.blk.next);⓪&IF bl = ADR (Root) THEN EXIT END; (* wir haben alle Blocks durch *)⓪&IF NOT blkFull (bl) THEN⓪(av:= av + bl^.free⓪&END;⓪$END;⓪$RETURN av⓪"END AllAvail;⓪ ⓪ ⓪ PROCEDURE Keep ( addr: ADDRESS );⓪"VAR hd: PtrHead; bl: PtrBlock; full: BOOLEAN;⓪"BEGIN⓪$IF valid (addr,bl,hd,full) THEN⓪&IF full THEN⓪(bl^.level:= 0⓪&ELSE⓪(hd^.level:= 0⓪&END⓪$ELSE⓪&StorBase.Keep (addr)⓪$END⓪"END Keep;⓪ ⓪ ⓪ PROCEDURE Enlarge ( VAR addr: ADDRESS; add: LONGCARD; VAR ok: BOOLEAN );⓪"BEGIN⓪$ok:= FALSE;⓪$IF LONGINT (add) >= 0 THEN⓪&IF NOT resize (addr, -LONGINT (add)) THEN⓪(IF StorBase.FullStorBaseAccess () THEN⓪*StorBase.Enlarge (addr, add, ok)⓪(END⓪&ELSE⓪(ok:= TRUE⓪&END⓪$END⓪"END Enlarge;⓪"⓪ ⓪ PROCEDURE TrailAvail (ad: ADDRESS): LONGCARD;⓪"VAR hd: PtrHead; bl: PtrBlock; full: BOOLEAN;⓪"BEGIN⓪$IF valid (ad,bl,hd,full) THEN⓪&RETURN 0 (* !!! hier fehlt was *)⓪$ELSE⓪&RETURN StorBase.TrailAvail (ad)⓪$END;⓪"END TrailAvail;⓪ ⓪ ⓪ PROCEDURE More (id:INTEGER;p:ADDRESS);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A0⓪(MOVE.W -(A3),D0⓪(CMPI.W #$4EF1,D0⓪(BNE trail⓪(MOVE.L (A0)+,(A3)+⓪(MOVE.L (A0)+,(A3)+⓪(MOVE.L (A0)+,(A3)+⓪(; Enlarge ( VAR addr: ADDRESS; len: LONGCARD; VAR ok: BOOLEAN );⓪(JMP Enlarge⓪&trail⓪(CMPI.W #$4EF2,D0⓪(BNE getRoot⓪(MOVE.L (A0)+,(A3)+⓪(MOVE.L A0,-(A7)⓪(; TrailAvail (ad: ADDRESS): LONGCARD;⓪(JSR TrailAvail⓪(MOVE.L (A7)+,A0⓪(MOVE.L -(A3),(A0)⓪(BRA ende⓪&getRoot⓪(CMPI.W #$4EF3,D0⓪(BNE _verify⓪(MOVE.L #Root,(A0)⓪(BRA ende⓪&_verify⓪(CMPI.W #$4EF4,D0⓪(BNE _resize⓪(MOVE.L #Verify,(A0)⓪(BRA ende⓪&_resize⓪(CMPI.W #$4EF5,D0⓪(BNE ende⓪(MOVE.L #resize,(A0)⓪&ende⓪$END⓪"END More;⓪"(*$L=*)⓪ ⓪ (* --------------------------------- *)⓪ (* --------------------------------- *)⓪ ⓪ PROCEDURE terminate;⓪ ⓪"VAR bl1, bl: PtrBlock; ad: ADDRESS;⓪"VAR usedBeg: INTEGER; hd: PtrHead;⓪ ⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; bl:= ADDRESS (Root.blk.next);⓪(MOVE.L Root,A0⓪ ⓪(; LOOP⓪&loopBeg⓪(; IF bl = ADR (Root) THEN EXIT END; (* wir haben alle Blocks durch *)⓪(CMPA.L #Root,A0⓪(BEQ exitLoop⓪(; bl1:= ADDRESS (bl^.blk.next);⓪(MOVE.L (A0),A2⓪(; IF blkFull (bl) THEN⓪(BTST #6,Block.size(A0)⓪(BEQ notFull⓪(; IF bl^.level = StorLevel THEN⓪(MOVE.W Block.level(A0),D0⓪(CMP.W StorLevel,D0⓪(BNE notLev⓪(; ad:= ADR (bl^.fullData);⓪(; DEALLOCATE (ad, 0)⓪(PEA Block.fullData(A0)⓪(MOVE.L A7,(A3)+⓪(CLR.L (A3)+⓪(MOVE.L A2,-(A7)⓪(JSR DEALLOCATE⓪(MOVE.L (A7)+,A2⓪(ADDQ.L #4,A7⓪(; END⓪¬Lev⓪(BRA wasFull⓪(; ELSE⓪¬Full⓪(; usedBeg:= bl^.hd.n; (* Start of new used area *)⓪(MOVE.W Block.hd.n(A0),D0⓪(; WHILE usedBeg >= 0 DO⓪&whileBeg⓪(TST.W D0⓪(BMI whileEnd⓪(; hd:= abs (bl, usedBeg);⓪(; MOVE.L A0,A1⓪(; ADDA.W D0,A1⓪(; ADDA.W #BlockSize,A1⓪(LEA BlockSize(A0,D0.W),A1⓪(; usedBeg:= nextHd (bl, usedBeg);⓪(MOVE.W Head.hd.n+BlockSize(A0,D0.W),D0⓪(; IF hd^.level = StorLevel THEN⓪(MOVE.W Head.level(A1),D1⓪(CMP.W StorLevel,D1⓪(BNE notLev2⓪(; ad:= ADR (hd^.data);⓪(; DEALLOCATE (ad, 0)⓪(PEA Head.data(A1)⓪(MOVE.L A7,(A3)+⓪(CLR.L (A3)+⓪(MOVEM.L D0/A0/A2,-(A7)⓪(JSR DEALLOCATE⓪(MOVEM.L (A7)+,D0/A0/A2⓪(ADDQ.L #4,A7⓪(; END⓪¬Lev2⓪(; END⓪(BRA whileBeg⓪&whileEnd⓪(; END;⓪&wasFull⓪(; bl:= bl1⓪(MOVE.L A2,A0⓪(; END;⓪(BRA loopBeg⓪&exitLoop⓪(; DEC (StorLevel) (* wird zu Null, wenn Prg terminiert; somit werden *)⓪:(* bei resid. Prgs dann die Allocs wie SysAlloc be-*)⓪:(* handelt; ein neuer Prozeß startet wieder mit *)⓪:(* Level 1 *)⓪(SUBQ.W #1,StorLevel⓪$END⓪"END terminate;⓪"(*$L=*)⓪ ⓪ (*$L-*)⓪ PROCEDURE chgLevel ( doInc: BOOLEAN; child: BOOLEAN; VAR c: INTEGER );⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #4,A3⓪(MOVE.L -(A3),D0⓪(TST D0 ; child⓪(BEQ ende⓪(SWAP D0⓪(TST D0⓪(BNE inc⓪(JMP terminate⓪&inc⓪(ADDQ.W #1,StorLevel⓪&ende⓪$END⓪"END chgLevel;⓪ (*$L=*)⓪ ⓪ ⓪ VAR ehdl: EnvlpCarrier;⓪$thdl: TermCarrier;⓪$wsp: MemArea;⓪ ⓪ BEGIN (* main *)⓪"WITH Root DO⓪$blk.prev:= ADR (Root);⓪$blk.next:= ADR (Root);⓪$blRov:= NIL⓪"END;⓪"StorLevel:= 1;⓪"IF MaxBlSize = 0L THEN⓪$IF Accessory () THEN⓪&MaxBlSize:= 2048;⓪$ELSE⓪&MaxBlSize:= StorBase.MemAvail () DIV 40L;⓪$END⓪"END;⓪"IF MaxBlSize > $7F00L THEN MaxBlSize:= $7F00 END;⓪"IF ODD (MaxBlSize) THEN DEC (MaxBlSize) END;⓪"CatchProcessTerm (thdl,terminate,wsp);⓪"SetEnvelope (ehdl,chgLevel,wsp);⓪"ASSEMBLER⓪(PEA X(PC)⓪(MOVE #38,-(A7)⓪(TRAP #14⓪(ADDQ.L #6,A7⓪(BRA CONT⓪&X MOVE.L $432,_membot⓪(MOVE.L $436,_memtop⓪(RTS⓪&CONT⓪"END⓪ END Storage.⓪ ə
- (* $000037FC$000031FF$00002535$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFEA6F1B$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF38B1D$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF41FA4$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75$FFF2EA75Ç$000082B0T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00008222$000082B0$00007B0E$000082B0$00007B0E$000082B0$FFEC3C8E$FFEC3C8E$FFEC3C8E$00003071$FFEC3C8E$00002A11$0000305E$0000306B$00000EAE$00008544ÿÇâ*)
-
